﻿package Xls2dat;
use strict;

use utf8;
BEGIN {
	unshift @INC, "..";
}
use Unicode::Japanese;

our @SHARP_NORMAL_TABLE;
our @NORMAL_TABLE;
our @ADD_FOR_SORT;
our %SHARP_LANG_TABLE;
our %OVERWRITE_SORT;

my @SHARP_TABLE;
my %PHASE1_TABLE;
my %PHASE2_TABLE;
my $sub_del;
my $sort_word_list;
our $lang;

#-----------------------------------------------------------
# 簡易会話ワードのソート。
#-----------------------------------------------------------
sub sort_simple {
	my ($word_list, $total_word_list, $category_word_list) = @_;

	prepare_table();
	$sort_word_list = trans_sort($word_list);
	for my $i (@{$category_word_list}) {
		@{$i} = sort simple_compare @{$i};
	}
	@{$total_word_list} = sort simple_compare @{$total_word_list};
	if (0) {
		open TEST, ">res.txt";
		for my $i (@{$total_word_list}) {
			my $word = $sort_word_list->[$i]{word};
			my $temp = substr($word . "\x{0101}", 0, length($word));

			print TEST Unicode::Japanese->new("$temp\n")->utf8;
		}
		close TEST;
		my $cnt = 0;
		for my $i (@{$category_word_list}) {
			open TEST, ">res${cnt}.txt";
			for my $j (@{$i}) {
				my $word = $sort_word_list->[$j]{word};
				my $temp = substr($word . "\x{0101}", 0, length($word));

				print TEST Unicode::Japanese->new("$temp\n")->utf8;
			}
			close TEST;
			$cnt++;
		}
		return;
	}
	output_sort_result($total_word_list, $category_word_list);
}

#-----------------------------------------------------------
# ソート文字列への変換用テーブル。
#-----------------------------------------------------------
sub prepare_table {
	register_sharp_table(\@SHARP_NORMAL_TABLE);
	register_sharp_table($SHARP_LANG_TABLE{$lang});

	register_phase_table(\@NORMAL_TABLE);
	register_phase_table(\@ADD_FOR_SORT);

	if ($lang eq "Spanish") {
		register_phase_table($OVERWRITE_SORT{Spanish});
		$sub_del = \&del_spanish;
	} elsif ($lang eq "Italian") {
		$sub_del = create_del_italian();
	} else {
		$sub_del = \&del_dummy;
	}
}

#-----------------------------------------------------------
# シャープ文字として登録。
#-----------------------------------------------------------
sub register_sharp_table {
	my ($src) = @_;

	for my $i (@{$src}) {
		my $sort_conv = $i->{sort_conv};

		if (defined($sort_conv)) {
			push @SHARP_TABLE, { reg => qr/\Q#$i->{trans}/, replace => $sort_conv };
		}
	}
}

#-----------------------------------------------------------
# 変換文字として登録。
#-----------------------------------------------------------
sub register_phase_table {
	my ($src) = @_;

	for my $i (@{$src}) {
		my $phase1 = $i->{phase1};
		my $phase2 = $i->{phase2};

		if (defined($phase1)) {
			$PHASE1_TABLE{$i->{trans}} = $phase1;
		}
		if (defined($phase2)) {
			$PHASE2_TABLE{$i->{trans}} = $phase2;
		}
	}
}

#-----------------------------------------------------------
# スペイン語のときの、文字消去関数。
#-----------------------------------------------------------
sub del_spanish {
	my ($word) = @_;
	my $tmp = $word;

	# ','を消去した結果、文字列が無くならなければ、それを採用。
	$tmp =~ tr/,//d;
	if (length($tmp) != 0) {
		$word = $tmp;
	}

	return $word;
}

#-----------------------------------------------------------
# イタリア語のときの、文字消去関数生成。
#-----------------------------------------------------------
sub create_del_italian {
	my @reg;
	my $sub;

	for my $i (@{$OVERWRITE_SORT{Italian}}) {
		push @reg, qr/\Q$i/;
	}
	$sub = sub {
		my ($word) = @_;

		if ($word =~ /[a-zA-Z0-9]/) {
			for my $i (@reg) {
				$word =~ s/$i//g;
			}
		}

		return $word;
	};

	return $sub;
}

#-----------------------------------------------------------
# 文字消去関数ダミー。
#-----------------------------------------------------------
sub del_dummy {
	my ($word) = @_;

	return $word;
}

#-----------------------------------------------------------
# ソート用文字列生成。
#-----------------------------------------------------------
sub trans_sort {
	my ($word_list) = @_;
	my $sort_word_list;

	for my $i (@{$word_list}) {
		my $word1 = $i->{word};
		my $word2;
		my ($phase1, $phase2);
		my $c;

		# まず、シャープ文字を変換。
		for my $j (@SHARP_TABLE) {
			$word1 =~ s/$j->{reg}/$j->{replace}/g;
		}
		# この段階でシャープ文字が残っていればNG。
		if ($word1 =~ /#/) {
			error_log("簡易会話用ワードに、未対応のシャープ文字がある:$word1", 0, 0);
			next;
		}
		$word2 = $word1;
		# 第１フェーズ用生成：
		$word1 = $sub_del->($word1);
		while (($c = substr($word1, 0, 1, "")) ne "") {
			my $rep;

			$rep = $PHASE1_TABLE{$c};
			if (!defined($rep)) {
				$rep = $c;
			}
			$phase1 .= $rep;
		}
		# 第２フェーズ用生成：
		while (($c = substr($word2, 0, 1, "")) ne "") {
			my $rep;

			$rep = $PHASE2_TABLE{$c};
			if (!defined($rep)) {
				$rep = $c;
			}
			$phase2 .= $rep;
		}
		push @{$sort_word_list}, { word => $i->{word}, code => $i->{code},
			no => $i->{no}, phase1 => $phase1, phase2 => $phase2 };
	}

	return $sort_word_list;
}

#-----------------------------------------------------------
# ワード比較関数。
#-----------------------------------------------------------
sub simple_compare {
	my $w_a = $sort_word_list->[$a];
	my $w_b = $sort_word_list->[$b];

	# まず第１フェーズ、それが同じなら第２フェーズの比較。
	return $w_a->{phase1} cmp $w_b->{phase1} || $w_a->{phase2} cmp $w_b->{phase2}
		|| $w_a->{code} <=> $w_b->{code};
}

#-----------------------------------------------------------
# ソート結果を出力。
#-----------------------------------------------------------
sub output_sort_result() {
	my ($total_word_list, $category_word_list) = @_;
	our $lang_dir;
	my $SORT_FILE = "resource/$lang_dir/kaiwa.dat";
	my $path = rel_path_from($SORT_FILE);
	my ($out_file, $out_new);
	my @check_ind;

	open OUTPUT, $path or die "error: open $path\n";
	$out_file = Unicode::Japanese->new(join("", <OUTPUT>), 'sjis')->getu;
	close OUTPUT;

	$out_file = output_pokemon_and_waza($out_file, $category_word_list);
	$out_file = output_other_category($out_file, $category_word_list);
	$out_file = output_total_category($out_file, $total_word_list);

	output($path, $out_file);
}

#-----------------------------------------------------------
# ポケモン名とわざ名のカテゴリ結果を出力。
#-----------------------------------------------------------
sub output_pokemon_and_waza {
	my ($out_file, $category_word_list) = @_;
	my $out_new;
	my @check_ind;
	my ($prev_pos, $cnt);

	@check_ind = ( 0, 18, 19, 21 );
	$out_new = "";
	$prev_pos = 0;
	$cnt = 0;
	while ($out_file =~ /^static const u16 Category(\d{2})Index\[\] = \{$/mg) {
		my $category = $1;
		my $s = pos($out_file);
		my $e;

		unless ($out_file =~ /\};/mg) {
			error_log("カテゴリ${category}の終端が見つからない。", 0, "");
			last;
		}
		$e = pos($out_file) - 2;

		if ($category != $check_ind[$cnt]) {
			error_log("カテゴリ${category}は順番通りでない。", 0, "");
			next;
		}

		$out_new .= substr($out_file, $prev_pos, $s - $prev_pos) . "\n";
		# ソート結果反映。
		for my $i (@{$category_word_list->[$category]}) {
			my $no = $sort_word_list->[$i]{no};
			my $word = $sort_word_list->[$i]{word};

			$out_new .= "\t$no,\t// $word\n";
		}
		$prev_pos = $e;
		$cnt++;
	}
	$out_new .= substr($out_file, $prev_pos);

	return $out_new;
}

#-----------------------------------------------------------
# ポケモンとわざ以外のカテゴリ結果を出力。
#-----------------------------------------------------------
sub output_other_category {
	my ($out_file, $category_word_list) = @_;
	my $out_new;
	my @check_ind;
	my ($prev_pos, $cnt, $cnt_no, $cur_category);
	my $list;

	@check_ind = ( 1 .. 17, 20 );
	$out_new = "";
	$cur_category = -1;
	$prev_pos = 0;
	$cnt = 0;
	while ($out_file =~ /\t\{\s*Category(\d{2})Str(\d{3})\s*,/mg) {
		my ($category, $no) = ($1, $2);
		my $s = pos($out_file);
		my $e;

		unless ($out_file =~ /\G\s*\d+,/mg) {
			error_log("カテゴリ${category}の${no}の終端が見つからない。", 0, "");
			last;
		}
		$e = pos($out_file);

		if ($category != $cur_category) {
			if (defined($list) && $cnt_no != @{$list}) {
				error_log("カテゴリ${cur_category}は全数ない。", 0, "");
			}
			if ($category != $check_ind[$cnt]) {
				error_log("カテゴリ${category}は順番通りでない。", 0, "");
				next;
			}
			$cur_category = $category;
			$list = $category_word_list->[$category];
			$cnt++;
			$cnt_no = 0;
		}
		if ($no != $cnt_no) {
			error_log("カテゴリ${category}の${no}は順番通りでない。", 0, "");
			next;
		}

		$out_new .= substr($out_file, $prev_pos, $s - $prev_pos);
		# [注]kaiwa.datのデータ構造はメッセージに対するソート順、に見えるが、
		#     実は、ソート順に対するメッセージ番号で記述されている。
		$out_new .= sprintf("%3d,", $sort_word_list->[$list->[$no]]{no});
		$prev_pos = $e;
		$cnt_no++;
	}
	if (defined($list) && $cnt_no != @{$list}) {
		error_log("カテゴリ${cur_category}は全数ない。", 0, "");
	}
	$out_new .= substr($out_file, $prev_pos);

	return $out_new;
}

#-----------------------------------------------------------
# 全ワードでのソート結果を出力。
#-----------------------------------------------------------
sub output_total_category {
	my ($out_file, $total_word_list) = @_;
	my $out_new;
	my $i;
	my ($prev_pos, $bound, $index);

	$i == 0;
	$bound = "A";
	$index = 0;
	$out_new = "";
	$prev_pos = 0;
	while ($i != @{$total_word_list}) {
		my ($s, $e);
		my $sort_text;

		# 記号/A/B/.../Z毎にリストアップ。
		while ($i != @{$total_word_list}) {
			my $info = $sort_word_list->[$total_word_list->[$i]];
			my $more2;

			if (0 <= ($info->{phase1} cmp $bound)) {
				last;
			}
			$i++;
			$more2 = 0;
			if ($i != @{$total_word_list}) {
				my $n_info = $sort_word_list->[$total_word_list->[$i]];

				if ($info->{word} eq $n_info->{word}) {
					my @same = ( $info, $n_info );
					my $num = 2;

					$i++;
					while ($i != @{$total_word_list}) {
						$n_info = $sort_word_list->[$total_word_list->[$i]];
						if ($info->{word} eq $n_info->{word}) {
							push @same, $n_info;
						} else {
							last;
						}
						$i++;
						$num++;
					}
					$sort_text .= "\t0xffff,\t// 重複あり\n";
					$sort_text .= sprintf("\t0x%04x,\t// 重複数\n", $num);
					for my $j (@same) {
						$sort_text .= sprintf("\t0x%04x,\t// $j->{word}\n", $j->{code});
					}
					$more2 = 1;
				}
			}
			if (!$more2) {
				$sort_text .= sprintf("\t0x%04x,\t// $info->{word}\n", $info->{code});
			}
		}

		# 出力位置検索。
		unless ($out_file =~ /^static const u16 InitialIndex(\d{2})\[\] = \{$/mg) {
			error_log("全ワードの${index}の挿入位置が見つからない。", 0, "");
			last;
		}
		$s = pos($out_file);
		if ($1 != $index) {
			error_log("$index:インデックスの順番が違う。", 0, "");
			next;
		}
		unless ($out_file =~ /};/mg) {
			error_log("${index}の終端位置が見つからない。", 0, "");
			last;
		}
		$e = pos($out_file) - 2;

		# 結果を出力。
		$out_new .= substr($out_file, $prev_pos, $s - $prev_pos) . "\n";
		$out_new .= $sort_text;
		$prev_pos = $e;
		if ($bound ne "Z") {
			$bound++;
		} else {
			$bound = "[";
		}
		$index++;
	}
	$out_new .= substr($out_file, $prev_pos);

	return $out_new;
}

1;
